home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / jpeg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-28  |  47.8 KB  |  1,401 lines
  1. unit jpeg;
  2.  
  3. interface
  4.  
  5. uses Windows, SysUtils, Classes, Graphics;
  6.  
  7. type
  8.   TJPEGAspectUnit = (jaUnknown, jaDotsPerInch, jaDotsPerCentimeter);
  9.  
  10.   TJPEGData = class(TSharedImage)
  11.   private
  12.     FData: TCustomMemoryStream;
  13.     FHeight: Integer;
  14.     FWidth: Integer;
  15.     FAspectUnit: TJPEGAspectUnit;
  16.     FAspectRatio: TPoint;
  17.     FGrayscale: Boolean;
  18. //    FComments: TStringList;
  19.   protected
  20.     procedure FreeHandle; override;
  21.   public
  22.     destructor Destroy; override;
  23.   end;
  24.  
  25.   TJPEGQualityRange = 1..100;   // 100 = best quality, 25 = pretty awful
  26.   TJPEGPerformance = (jpBestQuality, jpBestSpeed);
  27.   TJPEGScale = (jsFullSize, jsHalf, jsQuarter, jsEighth);
  28.   TJPEGPixelFormat = (jf24Bit, jf8Bit);
  29.  
  30.   TJPEGImage = class(TGraphic)
  31.   private
  32.     FImage: TJPEGData;
  33.     FBitmap: TBitmap;
  34.     FScaledWidth: Integer;
  35.     FScaledHeight: Integer;
  36.     FTempPal: HPalette;
  37. //    FComments: TStringList;
  38.     FSmoothing: Boolean;
  39.     FGrayScale: Boolean;
  40.     FPixelFormat: TJPEGPixelFormat;
  41.     FQuality: TJPEGQualityRange;
  42.     FProgressiveDisplay: Boolean;
  43.     FProgressiveEncoding: Boolean;
  44.     FPerformance: TJPEGPerformance;
  45.     FScale: TJPEGScale;
  46.     FNeedRecalc: Boolean;
  47.     procedure CalcOutputDimensions;
  48. //    procedure CommentsChanged(Sender: TObject);
  49.     function GetBitmap: TBitmap;
  50. //    function GetComments: TStrings;
  51.     function GetGrayscale: Boolean;
  52. //    procedure SetComments(Value: TStrings);
  53.     procedure SetGrayscale(Value: Boolean);
  54.     procedure SetPerformance(Value: TJPEGPerformance);
  55.     procedure SetPixelFormat(Value: TJPEGPixelFormat);
  56.     procedure SetScale(Value: TJPEGScale);
  57.     procedure SetSmoothing(Value: Boolean);
  58.   protected
  59.     procedure AssignTo(Dest: TPersistent); override;
  60.     procedure Changed(Sender: TObject); override;
  61.     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
  62.     function Equals(Graphic: TGraphic): Boolean; override;
  63.     procedure FreeBitmap;
  64.     function GetEmpty: Boolean; override;
  65.     function GetHeight: Integer; override;
  66.     function GetPalette: HPALETTE; override;
  67.     function GetWidth: Integer; override;
  68.     procedure NewBitmap;
  69.     procedure NewImage;
  70.     procedure ReadData(Stream: TStream); override;
  71.     procedure ReadStream(Size: Longint; Stream: TStream);
  72.     procedure SetHeight(Value: Integer); override;
  73.     procedure SetWidth(Value: Integer); override;
  74.     procedure WriteData(Stream: TStream); override;
  75.     property Bitmap: TBitmap read GetBitmap;  // volatile
  76.   public
  77.     constructor Create; override;
  78.     destructor Destroy; override;
  79.     procedure Assign(Source: TPersistent); override;
  80.     procedure LoadFromStream(Stream: TStream); override;
  81.     procedure SaveToStream(Stream: TStream); override;
  82.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  83.       APalette: HPALETTE); override;
  84.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  85.       var APalette: HPALETTE); override;
  86.  
  87. //    property Comments: TStrings read GetComments write SetComments;
  88.  
  89.     property Grayscale: Boolean read GetGrayscale write SetGrayscale;
  90.     property ProgressiveEncoding: Boolean read FProgressiveEncoding write FProgressiveEncoding;
  91.     property Smoothing: Boolean read FSmoothing write SetSmoothing;
  92. {    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
  93.  
  94.     // Original image info
  95.     property OriginalHeight: Integer read GetOriginalHeight write SetOriginalHeight;
  96.     property OriginalWidth: Integer read GetOriginalWidth write SetOriginalWidth;
  97.     property AspectUnit: TJPEGAspectUnit read GetAspectUnit write SetAspectUnit;
  98.     property AspectRatio: TPoint read GetAspectRatio write SetAspectRatio;
  99. }
  100.     // Compression options
  101.     property CompressionQuality: TJPEGQualityRange read FQuality write FQuality;
  102.  
  103.     // Decompression options
  104.     property PixelFormat: TJPEGPixelFormat read FPixelFormat write SetPixelFormat;
  105.     property ProgressiveDisplay: Boolean read FProgressiveDisplay write FProgressiveDisplay;
  106.     property Performance: TJPEGPerformance read FPerformance write SetPerformance;
  107.     property Scale: TJPEGScale read FScale write SetScale;
  108.   end;
  109.  
  110.  
  111. implementation
  112.  
  113. resourcestring
  114.   SChangeJPGSize = 'Cannot change the size of a JPEG image';
  115.  
  116. { The following types and external function declarations are used to
  117.   call into functions of the Independent JPEG Group's (IJG) implementation
  118.   of the JPEG image compression/decompression standard.  The IJG
  119.   library's C source code is compiled into OBJ files and linked into
  120.   the Delphi application. Only types and functions needed by this unit
  121.   are declared; all library internal structures are stubbed out with
  122.   generic pointers to reduce internal source code congestion.
  123.  
  124.   IJG source code copyright (C) 1991-1996, Thomas G. Lane. }
  125.  
  126. {$Z4}  // Minimum enum size = dword
  127.  
  128. Const
  129.   JPEG_LIB_VERSION = 61;        { Version 6a }
  130.  
  131.   JPEG_RST0     = $D0;  { RST0 marker code }
  132.   JPEG_EOI      = $D9;  { EOI marker code }
  133.   JPEG_APP0     = $E0;  { APP0 marker code }
  134.   JPEG_COM      = $FE;  { COM marker code }
  135.  
  136.   DCTSIZE             = 8;      { The basic DCT block is 8x8 samples }
  137.   DCTSIZE2            = 64;     { DCTSIZE squared; # of elements in a block }
  138.   NUM_QUANT_TBLS      = 4;      { Quantization tables are numbered 0..3 }
  139.   NUM_HUFF_TBLS       = 4;      { Huffman tables are numbered 0..3 }
  140.   NUM_ARITH_TBLS      = 16;     { Arith-coding tables are numbered 0..15 }
  141.   MAX_COMPS_IN_SCAN   = 4;      { JPEG limit on # of components in one scan }
  142.   MAX_SAMP_FACTOR     = 4;      { JPEG limit on sampling factors }
  143.   C_MAX_BLOCKS_IN_MCU = 10;     { compressor's limit on blocks per MCU }
  144.   D_MAX_BLOCKS_IN_MCU = 10;     { decompressor's limit on blocks per MCU }
  145.   MAX_COMPONENTS = 10;          { maximum number of image components (color channels) }
  146.  
  147.   MAXJSAMPLE = 255;
  148.   CENTERJSAMPLE = 128;
  149.  
  150. type
  151.   JSAMPLE = byte;
  152.   GETJSAMPLE = integer;
  153.   JCOEF = integer;
  154.   JCOEF_PTR = ^JCOEF;
  155.   UINT8 = byte;
  156.   UINT16 = Word;
  157.   UINT = Cardinal;
  158.   INT16 = SmallInt;
  159.   INT32 = Integer;
  160.   INT32PTR = ^INT32;
  161.   JDIMENSION = Cardinal;
  162.  
  163.   JOCTET = Byte;
  164.   jTOctet = 0..(MaxInt div SizeOf(JOCTET))-1;
  165.   JOCTET_FIELD = array[jTOctet] of JOCTET;
  166.   JOCTET_FIELD_PTR = ^JOCTET_FIELD;
  167.   JOCTETPTR = ^JOCTET;
  168.  
  169.   JSAMPLE_PTR = ^JSAMPLE;
  170.   JSAMPROW_PTR = ^JSAMPROW;
  171.  
  172.   jTSample = 0..(MaxInt div SIZEOF(JSAMPLE))-1;
  173.   JSAMPLE_ARRAY = Array[jTSample] of JSAMPLE;  {far}
  174.   JSAMPROW = ^JSAMPLE_ARRAY;  { ptr to one image row of pixel samples. }
  175.  
  176.   jTRow = 0..(MaxInt div SIZEOF(JSAMPROW))-1;
  177.   JSAMPROW_ARRAY = Array[jTRow] of JSAMPROW;
  178.   JSAMPARRAY = ^JSAMPROW_ARRAY;  { ptr to some rows (a 2-D sample array) }
  179.  
  180.   jTArray = 0..(MaxInt div SIZEOF(JSAMPARRAY))-1;
  181.   JSAMP_ARRAY = Array[jTArray] of JSAMPARRAY;
  182.   JSAMPIMAGE = ^JSAMP_ARRAY;  { a 3-D sample array: top index is color }
  183.  
  184. { Values of global_state field (jdapi.c has some dependencies on ordering!) }
  185. const
  186.   CSTATE_START        = 100;    { after create_compress }
  187.   CSTATE_SCANNING     = 101;    { start_compress done, write_scanlines OK }
  188.   CSTATE_RAW_OK       = 102;    { start_compress done, write_raw_data OK }
  189.   CSTATE_WRCOEFS      = 103;    { jpeg_write_coefficients done }
  190.   DSTATE_START        = 200;    { after create_decompress }
  191.   DSTATE_INHEADER     = 201;    { reading header markers, no SOS yet }
  192.   DSTATE_READY        = 202;    { found SOS, ready for start_decompress }
  193.   DSTATE_PRELOAD      = 203;    { reading multiscan file in start_decompress}
  194.   DSTATE_PRESCAN      = 204;    { performing dummy pass for 2-pass quant }
  195.   DSTATE_SCANNING     = 205;    { start_decompress done, read_scanlines OK }
  196.   DSTATE_RAW_OK       = 206;    { start_decompress done, read_raw_data OK }
  197.   DSTATE_BUFIMAGE     = 207;    { expecting jpeg_start_output }
  198.   DSTATE_BUFPOST      = 208;    { looking for SOS/EOI in jpeg_finish_output }
  199.   DSTATE_RDCOEFS      = 209;    { reading file in jpeg_read_coefficients }
  200.   DSTATE_STOPPING     = 210;    { looking for EOI in jpeg_finish_decompress }
  201.  
  202. { Known color spaces. }
  203.  
  204. type
  205.   J_COLOR_SPACE = (
  206.     JCS_UNKNOWN,            { error/unspecified }
  207.     JCS_GRAYSCALE,          { monochrome }
  208.     JCS_RGB,                { red/green/blue }
  209.     JCS_YCbCr,              { Y/Cb/Cr (also known as YUV) }
  210.     JCS_CMYK,               { C/M/Y/K }
  211.     JCS_YCCK                { Y/Cb/Cr/K }
  212.                   );
  213.  
  214. { DCT/IDCT algorithm options. }
  215.  
  216. type
  217.   J_DCT_METHOD = (
  218.     JDCT_ISLOW,        { slow but accurate integer algorithm }
  219.     JDCT_IFAST,        { faster, less accurate integer method }
  220.     JDCT_FLOAT        { floating-point: accurate, fast on fast HW (Pentium)}
  221.                  );
  222.  
  223. { Dithering options for decompression. }
  224.  
  225. type
  226.   J_DITHER_MODE = (
  227.     JDITHER_NONE,               { no dithering }
  228.     JDITHER_ORDERED,            { simple ordered dither }
  229.     JDITHER_FS                  { Floyd-Steinberg error diffusion dither }
  230.                   );
  231.  
  232. { Error handler }
  233.  
  234. const
  235.   JMSG_LENGTH_MAX  = 200;  { recommended size of format_message buffer }
  236.   JMSG_STR_PARM_MAX = 80;
  237.  
  238. type
  239.   jpeg_error_mgr_ptr = ^jpeg_error_mgr;
  240.   jpeg_progress_mgr_ptr = ^jpeg_progress_mgr;
  241.  
  242.   j_common_ptr = ^jpeg_common_struct;
  243.   j_compress_ptr = ^jpeg_compress_struct;
  244.   j_decompress_ptr = ^jpeg_decompress_struct;
  245.  
  246. { Routine signature for application-supplied marker processing methods.
  247.   Need not pass marker code since it is stored in cinfo^.unread_marker. }
  248.  
  249.   jpeg_marker_parser_method = function(cinfo : j_decompress_ptr) : LongBool;
  250.  
  251. { Marker reading & parsing }
  252.   jpeg_marker_reader_ptr = ^jpeg_marker_reader;
  253.   jpeg_marker_reader = record
  254.     reset_marker_reader : procedure(cinfo : j_decompress_ptr);
  255.     { Read markers until SOS or EOI.
  256.       Returns same codes as are defined for jpeg_consume_input:
  257.       JPEG_SUSPENDED, JPEG_REACHED_SOS, or JPEG_REACHED_EOI. }
  258.  
  259.     read_markers : function (cinfo : j_decompress_ptr) : Integer;
  260.     { Read a restart marker --- exported for use by entropy decoder only }
  261.     read_restart_marker : jpeg_marker_parser_method;
  262.     { Application-overridable marker processing methods }
  263.     process_COM : jpeg_marker_parser_method;
  264.     process_APPn : Array[0..16-1] of jpeg_marker_parser_method;
  265.  
  266.     { State of marker reader --- nominally internal, but applications
  267.       supplying COM or APPn handlers might like to know the state. }
  268.  
  269.     saw_SOI : LongBool;            { found SOI? }
  270.     saw_SOF : LongBool;            { found SOF? }
  271.     next_restart_num : Integer;    { next restart number expected (0-7) }
  272.     discarded_bytes : UINT;        { # of bytes skipped looking for a marker }
  273.   end;
  274.  
  275.   {int8array = Array[0..8-1] of int;}
  276.   int8array = Array[0..8-1] of Integer;
  277.  
  278.   jpeg_error_mgr = record
  279.     { Error exit handler: does not return to caller }
  280.     error_exit : procedure  (cinfo : j_common_ptr);
  281.     { Conditionally emit a trace or warning message }
  282.     emit_message : procedure (cinfo : j_common_ptr; msg_level : Integer);
  283.     { Routine that actually outputs a trace or error message }
  284.     output_message : procedure (cinfo : j_common_ptr);
  285.     { Format a message string for the most recent JPEG error or message }
  286.     format_message : procedure  (cinfo : j_common_ptr; buffer: PChar);
  287.     { Reset error state variables at start of a new image }
  288.     reset_error_mgr : procedure (cinfo : j_common_ptr);
  289.  
  290.     { The message ID code and any parameters are saved here.
  291.       A message can have one string parameter or up to 8 int parameters. }
  292.  
  293.     msg_code : Integer;
  294.  
  295.     msg_parm : record
  296.       case byte of
  297.       0:(i : int8array);
  298.       1:(s : string[JMSG_STR_PARM_MAX]);
  299.     end;
  300.     trace_level : Integer;     { max msg_level that will be displayed }
  301.     num_warnings : Integer;    { number of corrupt-data warnings }
  302.   end;
  303.  
  304.  
  305. { Data destination object for compression }
  306.   jpeg_destination_mgr_ptr = ^jpeg_destination_mgr;
  307.   jpeg_destination_mgr = record
  308.     next_output_byte : JOCTETptr;  { => next byte to write in buffer }
  309.     free_in_buffer : Longint;    { # of byte spaces remaining in buffer }
  310.  
  311.     init_destination : procedure (cinfo : j_compress_ptr);
  312.     empty_output_buffer : function (cinfo : j_compress_ptr) : LongBool;
  313.     term_destination : procedure (cinfo : j_compress_ptr);
  314.   end;
  315.  
  316.  
  317. { Data source object for decompression }
  318.  
  319.   jpeg_source_mgr_ptr = ^jpeg_source_mgr;
  320.   jpeg_source_mgr = record
  321.     next_input_byte : JOCTETptr;      { => next byte to read from buffer }
  322.     bytes_in_buffer : Longint;       { # of bytes remaining in buffer }
  323.  
  324.     init_source : procedure  (cinfo : j_decompress_ptr);
  325.     fill_input_buffer : function (cinfo : j_decompress_ptr) : LongBool;
  326.     skip_input_data : procedure (cinfo : j_decompress_ptr; num_bytes : Longint);
  327.     resync_to_restart : function (cinfo : j_decompress_ptr;
  328.                                   desired : Integer) : LongBool;
  329.     term_source : procedure (cinfo : j_decompress_ptr);
  330.   end;
  331.  
  332.     { Fields shared with jpeg_decompress_struct }
  333.   jpeg_common_struct = packed record
  334.     err : jpeg_error_mgr_ptr;        { Error handler module }
  335.     mem : Pointer;                   { Memory manager module }
  336.     progress : jpeg_progress_mgr_ptr;   { Progress monitor, or NIL if none }
  337.     is_decompressor : LongBool;      { so common code can tell which is which }
  338.     global_state : Integer;          { for checking call sequence validity }
  339.   end;
  340.  
  341. { Progress monitor object }
  342.  
  343.   jpeg_progress_mgr = record
  344.     progress_monitor : procedure(const cinfo : jpeg_common_struct);
  345.     pass_counter : Integer;     { work units completed in this pass }
  346.     pass_limit : Integer;       { total number of work units in this pass }
  347.     completed_passes : Integer;    { passes completed so far }
  348.     total_passes : Integer;     { total number of passes expected }
  349.     // extra Delphi info
  350.     instance: TJPEGImage;       // ptr to current TJPEGImage object
  351.     last_pass: Integer;
  352.     last_pct: Integer;
  353.     last_time: Integer;
  354.     last_scanline: Integer;
  355.   end;
  356.  
  357.  
  358. { Master record for a compression instance }
  359.  
  360.   jpeg_compress_struct = record
  361.     common: jpeg_common_struct;
  362.  
  363.     dest : jpeg_destination_mgr_ptr; { Destination for compressed data }
  364.  
  365.   { Description of source image --- these fields must be filled in by
  366.     outer application before starting compression.  in_color_space must
  367.     be correct before you can even call jpeg_set_defaults(). }
  368.  
  369.     image_width : JDIMENSION;         { input image width }
  370.     image_height : JDIMENSION;        { input image height }
  371.     input_components : Integer;       { # of color components in input image }
  372.     in_color_space : J_COLOR_SPACE;   { colorspace of input image }
  373.     input_gamma : double;             { image gamma of input image }
  374.  
  375.     // Compression parameters
  376.     data_precision : Integer;             { bits of precision in image data }
  377.     num_components : Integer;             { # of color components in JPEG image }
  378.     jpeg_color_space : J_COLOR_SPACE;     { colorspace of JPEG image }
  379.     comp_info : Pointer;
  380.     quant_tbl_ptrs: Array[0..NUM_QUANT_TBLS-1] of Pointer;
  381.     dc_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of Pointer;
  382.     ac_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of Pointer;
  383.     arith_dc_L : Array[0..NUM_ARITH_TBLS-1] of UINT8; { L values for DC arith-coding tables }
  384.     arith_dc_U : Array[0..NUM_ARITH_TBLS-1] of UINT8; { U values for DC arith-coding tables }
  385.     arith_ac_K : Array[0..NUM_ARITH_TBLS-1] of UINT8; { Kx values for AC arith-coding tables }
  386.     num_scans : Integer;         { # of entries in scan_info array }
  387.     scan_info : Pointer;     { script for multi-scan file, or NIL }
  388.     raw_data_in : LongBool;        { TRUE=caller supplies downsampled data }
  389.     arith_code : LongBool;         { TRUE=arithmetic coding, FALSE=Huffman }
  390.     optimize_coding : LongBool;    { TRUE=optimize entropy encoding parms }
  391.     CCIR601_sampling : LongBool;   { TRUE=first samples are cosited }
  392.     smoothing_factor : Integer;       { 1..100, or 0 for no input smoothing }
  393.     dct_method : J_DCT_METHOD;    { DCT algorithm selector }
  394.     restart_interval : UINT;      { MCUs per restart, or 0 for no restart }
  395.     restart_in_rows : Integer;        { if > 0, MCU rows per restart interval }
  396.  
  397.     { Parameters controlling emission of special markers. }
  398.     write_JFIF_header : LongBool;  { should a JFIF marker be written? }
  399.     { These three values are not used by the JPEG code, merely copied }
  400.     { into the JFIF APP0 marker.  density_unit can be 0 for unknown, }
  401.     { 1 for dots/inch, or 2 for dots/cm.  Note that the pixel aspect }
  402.     { ratio is defined by X_density/Y_density even when density_unit=0. }
  403.     density_unit : UINT8;         { JFIF code for pixel size units }
  404.     X_density : UINT16;           { Horizontal pixel density }
  405.     Y_density : UINT16;           { Vertical pixel density }
  406.     write_Adobe_marker : LongBool; { should an Adobe marker be written? }
  407.  
  408.     { State variable: index of next scanline to be written to
  409.       jpeg_write_scanlines().  Application may use this to control its
  410.       processing loop, e.g., "while (next_scanline < image_height)". }
  411.  
  412.     next_scanline : JDIMENSION;   { 0 .. image_height-1  }
  413.  
  414.     { Remaining fields are known throughout compressor, but generally
  415.       should not be touched by a surrounding application. }
  416.     progressive_mode : LongBool;   { TRUE if scan script uses progressive mode }
  417.     max_h_samp_factor : Integer;      { largest h_samp_factor }
  418.     max_v_samp_factor : Integer;      { largest v_samp_factor }
  419.     total_iMCU_rows : JDIMENSION; { # of iMCU rows to be input to coef ctlr }
  420.     comps_in_scan : Integer;          { # of JPEG components in this scan }
  421.     cur_comp_info : Array[0..MAX_COMPS_IN_SCAN-1] of Pointer;
  422.     MCUs_per_row : JDIMENSION;    { # of MCUs across the image }
  423.     MCU_rows_in_scan : JDIMENSION;{ # of MCU rows in the image }
  424.     blocks_in_MCU : Integer;          { # of DCT blocks per MCU }
  425.     MCU_membership : Array[0..C_MAX_BLOCKS_IN_MCU-1] of Integer;
  426.     Ss, Se, Ah, Al : Integer;         { progressive JPEG parameters for scan }
  427.  
  428.     { Links to compression subobjects (methods and private variables of modules) }
  429.     master : Pointer;
  430.     main : Pointer;
  431.     prep : Pointer;
  432.     coef : Pointer;
  433.     marker : Pointer;
  434.     cconvert : Pointer;
  435.     downsample : Pointer;
  436.     fdct : Pointer;
  437.     entropy : Pointer;
  438.   end;
  439.  
  440.  
  441. { Master record for a decompression instance }
  442.  
  443.   jpeg_decompress_struct = packed record
  444.     common: jpeg_common_struct;
  445.  
  446.     { Source of compressed data }
  447.     src : jpeg_source_mgr_ptr;
  448.  
  449.     { Basic description of image --- filled in by jpeg_read_header(). }
  450.     { Application may inspect these values to decide how to process image. }
  451.  
  452.     image_width : JDIMENSION;      { nominal image width (from SOF marker) }
  453.     image_height : JDIMENSION;     { nominal image height }
  454.     num_components : Integer;          { # of color components in JPEG image }
  455.     jpeg_color_space : J_COLOR_SPACE; { colorspace of JPEG image }
  456.  
  457.     { Decompression processing parameters }
  458.     out_color_space : J_COLOR_SPACE; { colorspace for output }
  459.     scale_num, scale_denom : uint ;  { fraction by which to scale image }
  460.     output_gamma : double;           { image gamma wanted in output }
  461.     buffered_image : LongBool;        { TRUE=multiple output passes }
  462.     raw_data_out : LongBool;          { TRUE=downsampled data wanted }
  463.     dct_method : J_DCT_METHOD;       { IDCT algorithm selector }
  464.     do_fancy_upsampling : LongBool;   { TRUE=apply fancy upsampling }
  465.     do_block_smoothing : LongBool;    { TRUE=apply interblock smoothing }
  466.     quantize_colors : LongBool;       { TRUE=colormapped output wanted }
  467.     { the following are ignored if not quantize_colors: }
  468.     dither_mode : J_DITHER_MODE;     { type of color dithering to use }
  469.     two_pass_quantize : LongBool;     { TRUE=use two-pass color quantization }
  470.     desired_number_of_colors : Integer;  { max # colors to use in created colormap }
  471.     { these are significant only in buffered-image mode: }
  472.     enable_1pass_quant : LongBool;    { enable future use of 1-pass quantizer }
  473.     enable_external_quant : LongBool; { enable future use of external colormap }
  474.     enable_2pass_quant : LongBool;    { enable future use of 2-pass quantizer }
  475.  
  476.     { Description of actual output image that will be returned to application.
  477.       These fields are computed by jpeg_start_decompress().
  478.       You can also use jpeg_calc_output_dimensions() to determine these values
  479.       in advance of calling jpeg_start_decompress(). }
  480.  
  481.     output_width : JDIMENSION;       { scaled image width }
  482.     output_height: JDIMENSION;       { scaled image height }
  483.     out_color_components : Integer;  { # of color components in out_color_space }
  484.     output_components : Integer;     { # of color components returned }
  485.     { output_components is 1 (a colormap index) when quantizing colors;
  486.       otherwise it equals out_color_components. }
  487.  
  488.     rec_outbuf_height : Integer;     { min recommended height of scanline buffer }
  489.     { If the buffer passed to jpeg_read_scanlines() is less than this many
  490.       rows high, space and time will be wasted due to unnecessary data
  491.       copying. Usually rec_outbuf_height will be 1 or 2, at most 4. }
  492.  
  493.     { When quantizing colors, the output colormap is described by these
  494.       fields. The application can supply a colormap by setting colormap
  495.       non-NIL before calling jpeg_start_decompress; otherwise a colormap
  496.       is created during jpeg_start_decompress or jpeg_start_output. The map
  497.       has out_color_components rows and actual_number_of_colors columns. }
  498.  
  499.     actual_number_of_colors : Integer;      { number of entries in use }
  500.     colormap : JSAMPARRAY;              { The color map as a 2-D pixel array }
  501.  
  502.     { State variables: these variables indicate the progress of decompression.
  503.       The application may examine these but must not modify them. }
  504.  
  505.     { Row index of next scanline to be read from jpeg_read_scanlines().
  506.       Application may use this to control its processing loop, e.g.,
  507.       "while (output_scanline < output_height)". }
  508.  
  509.     output_scanline : JDIMENSION; { 0 .. output_height-1  }
  510.  
  511.     { Current input scan number and number of iMCU rows completed in scan.
  512.       These indicate the progress of the decompressor input side. }
  513.  
  514.     input_scan_number : Integer;      { Number of SOS markers seen so far }
  515.     input_iMCU_row : JDIMENSION;  { Number of iMCU rows completed }
  516.  
  517.     { The "output scan number" is the notional scan being displayed by the
  518.       output side.  The decompressor will not allow output scan/row number
  519.       to get ahead of input scan/row, but it can fall arbitrarily far behind.}
  520.  
  521.     output_scan_number : Integer;     { Nominal scan number being displayed }
  522.     output_iMCU_row : Integer;        { Number of iMCU rows read }
  523.  
  524.     coef_bits : Pointer;
  525.  
  526.     { Internal JPEG parameters --- the application usually need not look at
  527.       these fields.  Note that the decompressor output side may not use
  528.       any parameters that can change between scans. }
  529.  
  530.     { Quantization and Huffman tables are carried forward across input
  531.       datastreams when processing abbreviated JPEG datastreams. }
  532.  
  533.     quant_tbl_ptrs : Array[0..NUM_QUANT_TBLS-1] of Pointer;
  534.     dc_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of Pointer;
  535.     ac_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of Pointer;
  536.  
  537.     { These parameters are never carried across datastreams, since they
  538.       are given in SOF/SOS markers or defined to be reset by SOI. }
  539.     data_precision : Integer;          { bits of precision in image data }
  540.     comp_info : Pointer;
  541.     progressive_mode : LongBool;    { TRUE if SOFn specifies progressive mode }
  542.     arith_code : LongBool;          { TRUE=arithmetic coding, FALSE=Huffman }
  543.     arith_dc_L : Array[0..NUM_ARITH_TBLS-1] of UINT8; { L values for DC arith-coding tables }
  544.     arith_dc_U : Array[0..NUM_ARITH_TBLS-1] of UINT8; { U values for DC arith-coding tables }
  545.     arith_ac_K : Array[0..NUM_ARITH_TBLS-1] of UINT8; { Kx values for AC arith-coding tables }
  546.  
  547.     restart_interval : UINT; { MCUs per restart interval, or 0 for no restart }
  548.  
  549.     { These fields record data obtained from optional markers recognized by
  550.       the JPEG library. }
  551.     saw_JFIF_marker : LongBool;  { TRUE iff a JFIF APP0 marker was found }
  552.     { Data copied from JFIF marker: }
  553.     density_unit : UINT8;       { JFIF code for pixel size units }
  554.     X_density : UINT16;         { Horizontal pixel density }
  555.     Y_density : UINT16;         { Vertical pixel density }
  556.     saw_Adobe_marker : LongBool; { TRUE iff an Adobe APP14 marker was found }
  557.     Adobe_transform : UINT8;    { Color transform code from Adobe marker }
  558.  
  559.     CCIR601_sampling : LongBool; { TRUE=first samples are cosited }
  560.  
  561.     { Remaining fields are known throughout decompressor, but generally
  562.       should not be touched by a surrounding application. }
  563.     max_h_samp_factor : Integer;    { largest h_samp_factor }
  564.     max_v_samp_factor : Integer;    { largest v_samp_factor }
  565.     min_DCT_scaled_size : Integer;  { smallest DCT_scaled_size of any component }
  566.     total_iMCU_rows : JDIMENSION; { # of iMCU rows in image }
  567.     sample_range_limit : Pointer;   { table for fast range-limiting }
  568.  
  569.     { These fields are valid during any one scan.
  570.       They describe the components and MCUs actually appearing in the scan.
  571.       Note that the decompressor output side must not use these fields. }
  572.     comps_in_scan : Integer;           { # of JPEG components in this scan }
  573.     cur_comp_info : Array[0..MAX_COMPS_IN_SCAN-1] of Pointer;
  574.     MCUs_per_row : JDIMENSION;     { # of MCUs across the image }
  575.     MCU_rows_in_scan : JDIMENSION; { # of MCU rows in the image }
  576.     blocks_in_MCU : JDIMENSION;    { # of DCT blocks per MCU }
  577.     MCU_membership : Array[0..D_MAX_BLOCKS_IN_MCU-1] of Integer;
  578.     Ss, Se, Ah, Al : Integer;          { progressive JPEG parameters for scan }
  579.  
  580.     { This field is shared between entropy decoder and marker parser.
  581.       It is either zero or the code of a JPEG marker that has been
  582.       read from the data source, but has not yet been processed. }
  583.     unread_marker : Integer;
  584.  
  585.     { Links to decompression subobjects
  586.       (methods, private variables of modules) }
  587.     master : Pointer;
  588.     main : Pointer;
  589.     coef : Pointer;
  590.     post : Pointer;
  591.     inputctl : Pointer;
  592.     marker : Pointer;
  593.     entropy : Pointer;
  594.     idct : Pointer;
  595.     upsample : Pointer;
  596.     cconvert : Pointer;
  597.     cquantize : Pointer;
  598.   end;
  599.  
  600.   TJPEGContext = record
  601.     err: jpeg_error_mgr;
  602.     progress: jpeg_progress_mgr;
  603.     FinalDCT: J_DCT_METHOD;
  604.     FinalTwoPassQuant: Boolean;
  605.     FinalDitherMode: J_DITHER_MODE;
  606.     case byte of
  607.       0: (common: jpeg_common_struct);
  608.       1: (d: jpeg_decompress_struct);
  609.       2: (c: jpeg_compress_struct);
  610.   end;
  611.  
  612. { Decompression startup: read start of JPEG datastream to see what's there
  613.    function jpeg_read_header (cinfo : j_decompress_ptr;
  614.                               require_image : LongBool) : Integer;
  615.   Return value is one of: }
  616. const
  617.   JPEG_SUSPENDED              = 0; { Suspended due to lack of input data }
  618.   JPEG_HEADER_OK              = 1; { Found valid image datastream }
  619.   JPEG_HEADER_TABLES_ONLY     = 2; { Found valid table-specs-only datastream }
  620. { If you pass require_image = TRUE (normal case), you need not check for
  621.   a TABLES_ONLY return code; an abbreviated file will cause an error exit.
  622.   JPEG_SUSPENDED is only possible if you use a data source module that can
  623.   give a suspension return (the stdio source module doesn't). }
  624.  
  625.  
  626. { function jpeg_consume_input (cinfo : j_decompress_ptr) : Integer;
  627.   Return value is one of: }
  628.  
  629.   JPEG_REACHED_SOS            = 1; { Reached start of new scan }
  630.   JPEG_REACHED_EOI            = 2; { Reached end of image }
  631.   JPEG_ROW_COMPLETED          = 3; { Completed one iMCU row }
  632.   JPEG_SCAN_COMPLETED         = 4; { Completed last iMCU row of a scan }
  633.  
  634.  
  635. // Stubs for external C RTL functions referenced by JPEG OBJ files.
  636.  
  637. function _malloc(size: Integer): Pointer; cdecl;
  638. begin
  639.   GetMem(Result, size);
  640. end;
  641.  
  642. procedure _free(P: Pointer); cdecl;
  643. begin
  644.   FreeMem(P);
  645. end;
  646.  
  647. procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
  648. begin
  649.   FillChar(P^, count, B);
  650. end;
  651.  
  652. procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
  653. begin
  654.   Move(source^, dest^, count);
  655. end;
  656.  
  657. function _fread(var buf; recsize, reccount: Integer; S: TStream): Integer; cdecl;
  658. begin
  659.   Result := S.Read(buf, recsize * reccount);
  660. end;
  661.  
  662. function _fwrite(const buf; recsize, reccount: Integer; S: TStream): Integer; cdecl;
  663. begin
  664.   Result := S.Write(buf, recsize * reccount);
  665. end;
  666.  
  667. function _fflush(S: TStream): Integer; cdecl;
  668. begin
  669.   Result := 0;
  670. end;
  671.  
  672. function __ftol: Integer;
  673. var
  674.   f: double;
  675. begin
  676.   asm
  677.     lea    eax, f             //  BC++ passes floats on the FPU stack
  678.     fstp  qword ptr [eax]     //  Delphi passes floats on the CPU stack
  679.   end;
  680.   Result := Trunc(f);
  681. end;
  682.  
  683. var
  684.   __turboFloat: LongBool = False;
  685.  
  686. {$L jdapimin.obj}
  687. {$L jmemmgr.obj}
  688. {$L jmemnobs.obj}
  689. {$L jdmarker.obj}
  690. {$L jcomapi.obj}
  691. {$L jdinput.obj}
  692. {$L jutils.obj}
  693. {$L jdatasrc.obj}
  694. {$L jdmaster.obj}
  695. {$L jdmainct.obj}
  696. {$L jdcoefct.obj}
  697. {$L jdpostct.obj}
  698. {$L jdhuff.obj}
  699. {$L jdphuff.obj}
  700. {$L jddctmgr.obj}
  701. {$L jdsample.obj}
  702. {$L jdcolor.obj}
  703. {$L jquant1.obj}
  704. {$L jquant2.obj}
  705. {$L jdmerge.obj}
  706. {$L jidctflt.obj}
  707. {$L jidctfst.obj}
  708. {$L jidctint.obj}
  709. {$L jidctred.obj}
  710. {$L jdapistd.obj}
  711.  
  712. //!! comment out one or more of the lines below to get an IDE compiler crash
  713. procedure jpeg_abort; external;
  714. procedure jinit_input_controller; external;
  715. procedure jinit_marker_reader; external;
  716. procedure jinit_memory_mgr; external;
  717. procedure jpeg_get_small; external;
  718. procedure jpeg_free_small; external;
  719. procedure jpeg_get_large; external;
  720. procedure jpeg_free_large; external;
  721. procedure jpeg_mem_available; external;
  722. procedure jpeg_open_backing_store; external;
  723. procedure jpeg_mem_init; external;
  724. procedure jpeg_mem_term; external;
  725. procedure jpeg_alloc_quant_table; external;
  726. procedure jpeg_alloc_huff_table; external;
  727. procedure _jpeg_natural_order; external;
  728. procedure jround_up; external;
  729. procedure jcopy_block_row; external;
  730. procedure jcopy_sample_rows; external;
  731. procedure jpeg_resync_to_restart; external;
  732. procedure jinit_d_main_controller; external;
  733. procedure jinit_d_coef_controller; external;
  734. procedure jinit_d_post_controller; external;
  735. procedure jinit_huff_decoder; external;
  736. procedure jinit_phuff_decoder; external;
  737. procedure jinit_inverse_dct; external;
  738. procedure jinit_upsampler; external;
  739. procedure jinit_color_deconverter; external;
  740. procedure jinit_1pass_quantizer; external;
  741. procedure jinit_2pass_quantizer; external;
  742. procedure jinit_merged_upsampler; external;
  743. procedure jpeg_make_d_derived_tbl; external;
  744. procedure jpeg_fill_bit_buffer; external;
  745. procedure jpeg_huff_decode; external;
  746. procedure jpeg_idct_islow; external;
  747. procedure jpeg_idct_ifast; external;
  748. procedure jpeg_idct_float; external;
  749. procedure jpeg_idct_4x4; external;
  750. procedure jpeg_idct_2x2; external;
  751. procedure jpeg_idct_1x1; external;
  752. procedure jinit_master_decompress; external;
  753.  
  754.  
  755. procedure jpeg_CreateDecompress (var cinfo : jpeg_decompress_struct;
  756.   version : integer; structsize : integer); external;
  757. procedure jpeg_stdio_src(var cinfo: jpeg_decompress_struct;
  758.   input_file: TStream); external;
  759. procedure jpeg_read_header(var cinfo: jpeg_decompress_struct;
  760.   RequireImage: LongBool); external;
  761. procedure jpeg_calc_output_dimensions(var cinfo: jpeg_decompress_struct); external;
  762. function jpeg_start_decompress(var cinfo: jpeg_decompress_struct): Longbool; external;
  763. function jpeg_read_scanlines(var cinfo: jpeg_decompress_struct;
  764.     scanlines: JSAMPARRAY; max_lines: JDIMENSION): JDIMENSION; external;
  765. function jpeg_finish_decompress(var cinfo: jpeg_decompress_struct): Longbool; external;
  766. procedure jpeg_destroy_decompress (var cinfo : jpeg_decompress_struct); external;
  767. function jpeg_has_multiple_scans(var cinfo: jpeg_decompress_struct): Longbool; external;
  768. function jpeg_consume_input(var cinfo: jpeg_decompress_struct): Integer; external;
  769. function jpeg_start_output(var cinfo: jpeg_decompress_struct; scan_number: Integer): Longbool; external;
  770. function jpeg_finish_output(var cinfo: jpeg_decompress_struct): LongBool; external;
  771. procedure jpeg_destroy(var cinfo: jpeg_common_struct); external;
  772.  
  773.  
  774.  
  775. type
  776.   EJPEG = class(EInvalidGraphic);
  777.  
  778. procedure InvalidOperation(const Msg: string); near;
  779. begin
  780.   raise EInvalidGraphicOperation.Create(Msg);
  781. end;
  782.  
  783. procedure JpegError(cinfo: j_common_ptr);
  784. begin
  785. //  raise EJPEG.CreateRes(cinfo^.err^.msg_code);
  786.   raise EJPEG.CreateFmt('JPEG error #%d',[cinfo^.err^.msg_code]);
  787. end;
  788.  
  789. procedure EmitMessage(cinfo: j_common_ptr; msg_level: Integer);
  790. begin
  791.   //!!
  792. end;
  793.  
  794. procedure OutputMessage(cinfo: j_common_ptr);
  795. begin
  796.   //!!
  797. end;
  798.  
  799. procedure FormatMessage(cinfo: j_common_ptr; buffer: PChar);
  800. begin
  801.   //!!
  802. end;
  803.  
  804. procedure ResetErrorMgr(cinfo: j_common_ptr);
  805. begin
  806.   cinfo^.err^.num_warnings := 0;
  807.   cinfo^.err^.msg_code := 0;
  808. end;
  809.  
  810.  
  811. const
  812.   jpeg_std_error: jpeg_error_mgr = (
  813.     error_exit: JpegError;
  814.     emit_message: EmitMessage;
  815.     output_message: OutputMessage;
  816.     format_message: FormatMessage;
  817.     reset_error_mgr: ResetErrorMgr);
  818.  
  819.  
  820. { TJPEGData }
  821.  
  822. destructor TJPEGData.Destroy;
  823. begin
  824.   FData.Free;
  825.   inherited Destroy;
  826. end;
  827.  
  828. procedure TJPEGData.FreeHandle;
  829. begin
  830. end;
  831.  
  832. { TJPEGImage }
  833.  
  834. constructor TJPEGImage.Create;
  835. begin
  836.   inherited Create;
  837.   NewImage;
  838. //  FComments := TStringList.Create;
  839. //  FComments.OnChange := CommentsChanged;
  840. end;
  841.  
  842. destructor TJPEGImage.Destroy;
  843. begin
  844. //  FComments.Free;
  845.   if FTempPal <> 0 then DeleteObject(FTempPal);
  846.   FBitmap.Free;
  847.   FImage.Release;
  848.   inherited Destroy;
  849. end;
  850.  
  851. procedure TJPEGImage.Assign(Source: TPersistent);
  852. begin
  853.   if Source is TJPEGImage then
  854.   begin
  855.     FImage.Release;
  856.     FImage := TJPEGImage(Source).FImage;
  857.     FImage.Reference;
  858. //      FComments.Assign(FImage.FComments);
  859.     if TJPEGImage(Source).FBitmap <> nil then
  860.     begin
  861.       NewBitmap;
  862.       FBitmap.Assign(TJPEGImage(Source).FBitmap);
  863.     end;
  864.   end
  865.   else if Source is TBitmap then
  866.   begin
  867.     NewImage;
  868.     NewBitmap;
  869.     FBitmap.Assign(Source);
  870.   end
  871.   else
  872.     inherited Assign(Source);
  873. end;
  874.  
  875. procedure TJPEGImage.AssignTo(Dest: TPersistent);
  876. begin
  877.   if Dest is TBitmap then
  878.     Dest.Assign(Bitmap)
  879.   else
  880.     inherited AssignTo(Dest);
  881. end;
  882.  
  883. procedure ProgressCallback(const cinfo: jpeg_common_struct);
  884. var
  885.   Ticks: Integer;
  886.   R: TRect;
  887.   temp: Integer;
  888. begin
  889.   if (cinfo.progress = nil) or (cinfo.progress^.instance = nil) then Exit;
  890.   with cinfo.progress^ do
  891.   begin
  892.     Ticks := GetTickCount;
  893.     if (Ticks - last_time) < 500 then Exit;
  894.     temp := last_time;
  895.     last_time := Ticks;
  896.     if temp = 0 then Exit;
  897.     if cinfo.is_decompressor then
  898.       with j_decompress_ptr(@cinfo)^ do
  899.       begin
  900.         R := Rect(0, last_scanline, output_width, output_scanline);
  901.         if R.Bottom < last_scanline then
  902.           R.Bottom := output_height;
  903.       end
  904.     else
  905.       R := Rect(0,0,0,0);
  906.     temp := Trunc(100.0*(completed_passes + (pass_counter/pass_limit))/total_passes);
  907.     if temp = last_pct then Exit;
  908.     last_pct := temp;
  909.     if cinfo.is_decompressor then
  910.       last_scanline := j_decompress_ptr(@cinfo)^.output_scanline;
  911.     instance.Progress(instance, psRunning, temp, (R.Bottom - R.Top) >= 4, R, '');
  912.   end;
  913. end;
  914.  
  915. procedure ReleaseContext(var jc: TJPEGContext);
  916. begin
  917.   if jc.common.err = nil then Exit;
  918.   jpeg_destroy(jc.common);
  919.   jc.common.err := nil;
  920. end;
  921.  
  922. procedure InitDecompressor(Obj: TJPEGImage; var jc: TJPEGContext);
  923. begin
  924.   FillChar(jc, sizeof(jc), 0);
  925.   jc.err := jpeg_std_error;
  926.   jc.common.err := @jc.err;
  927.  
  928.   jpeg_CreateDecompress(jc.d, JPEG_LIB_VERSION, sizeof(jc.d));
  929.   with Obj do
  930.   try
  931.     jc.progress.progress_monitor := @ProgressCallback;
  932.     jc.progress.instance := Obj;
  933.     jc.common.progress := @jc.progress;
  934.  
  935.     Obj.FImage.FData.Position := 0;
  936.     jpeg_stdio_src(jc.d, FImage.FData);
  937.     jpeg_read_header(jc.d, TRUE);
  938.  
  939.     jc.d.scale_num := 1;
  940.     jc.d.scale_denom := 1 shl Byte(FScale);
  941.     jc.d.do_block_smoothing := FSmoothing;
  942.  
  943.     if FGrayscale then jc.d.out_color_space := JCS_GRAYSCALE;
  944.     if (PixelFormat = jf8Bit) or (jc.d.out_color_space = JCS_GRAYSCALE) then
  945.     begin
  946.       jc.d.quantize_colors := True;
  947.       jc.d.desired_number_of_colors := 255;
  948.     end;
  949.  
  950.     if FPerformance = jpBestSpeed then
  951.     begin
  952.       jc.d.dct_method := JDCT_IFAST;
  953.       jc.d.two_pass_quantize := False;
  954. //      jc.d.do_fancy_upsampling := False;    !! AV inside jpeglib
  955.       jc.d.dither_mode := JDITHER_ORDERED;
  956.     end;
  957.  
  958.     jc.FinalDCT := jc.d.dct_method;
  959.     jc.FinalTwoPassQuant := jc.d.two_pass_quantize;
  960.     jc.FinalDitherMode := jc.d.dither_mode;
  961.     if FProgressiveDisplay and jpeg_has_multiple_scans(jc.d) then
  962.     begin  // save requested settings, reset for fastest on all but last scan
  963.       jc.d.enable_2pass_quant := jc.d.two_pass_quantize;
  964.       jc.d.dct_method := JDCT_IFAST;
  965.       jc.d.two_pass_quantize := False;
  966.       jc.d.dither_mode := JDITHER_ORDERED;
  967.       jc.d.buffered_image := True;
  968.     end;
  969.   except
  970.     ReleaseContext(jc);
  971.     raise;
  972.   end;
  973. end;
  974.  
  975. procedure TJPEGImage.CalcOutputDimensions;
  976. var
  977.   jc: TJPEGContext;
  978. begin
  979.   if not FNeedRecalc then Exit;
  980.   InitDecompressor(Self, jc);
  981.   try
  982.     jc.common.progress := nil;
  983.     jpeg_calc_output_dimensions(jc.d);
  984.     // read output dimensions
  985.     FScaledWidth := jc.d.output_width;
  986.     FScaledHeight := jc.d.output_height;
  987.     FProgressiveEncoding := jpeg_has_multiple_scans(jc.d);
  988.   finally
  989.     ReleaseContext(jc);
  990.   end;
  991. end;
  992.  
  993. procedure TJPEGImage.Changed(Sender: TObject);
  994. begin
  995.   inherited Changed(Sender);
  996. end;
  997.  
  998. procedure TJPEGImage.Draw(ACanvas: TCanvas; const Rect: TRect);
  999. begin
  1000.   ACanvas.StretchDraw(Rect, Bitmap);
  1001. end;
  1002.  
  1003. function TJPEGImage.Equals(Graphic: TGraphic): Boolean;
  1004. begin
  1005.   Result := (Graphic is TJPEGImage) and
  1006.     (FImage = TJPEGImage(Graphic).FImage); //!!
  1007. end;
  1008.  
  1009. procedure TJPEGImage.FreeBitmap;
  1010. begin
  1011.   FBitmap.Free;
  1012.   FBitmap := nil;
  1013. end;
  1014.  
  1015. type
  1016.   TMaxLogPalette = packed record
  1017.     palVersion: Word;
  1018.     palNumEntries: Word;
  1019.     palPalEntry: array [Byte] of TPaletteEntry;
  1020.   end;
  1021.  
  1022. function BuildPalette(const cinfo: jpeg_decompress_struct): HPalette;
  1023. var
  1024.   Pal: TMaxLogPalette;
  1025.   I: Integer;
  1026.   C: Byte;
  1027. begin
  1028.   Pal.palVersion := $300;
  1029.   Pal.palNumEntries := cinfo.actual_number_of_colors;
  1030.   if cinfo.out_color_space = JCS_GRAYSCALE then
  1031.     for I := 0 to Pal.palNumEntries-1 do
  1032.     begin
  1033.       C := cinfo.colormap^[0]^[I];
  1034.       Pal.palPalEntry[I].peRed := C;
  1035.       Pal.palPalEntry[I].peGreen := C;
  1036.       Pal.palPalEntry[I].peBlue := C;
  1037.       Pal.palPalEntry[I].peFlags := 0;
  1038.     end
  1039.   else
  1040.     for I := 0 to Pal.palNumEntries-1 do
  1041.     begin
  1042.       Pal.palPalEntry[I].peRed := cinfo.colormap^[2]^[I];
  1043.       Pal.palPalEntry[I].peGreen := cinfo.colormap^[1]^[I];
  1044.       Pal.palPalEntry[I].peBlue := cinfo.colormap^[0]^[I];
  1045.       Pal.palPalEntry[I].peFlags := 0;
  1046.     end;
  1047.   Result := CreatePalette(PLogPalette(@Pal)^);
  1048. end;
  1049.  
  1050. function TJPEGImage.GetBitmap: TBitmap;
  1051. var
  1052.   num_scanlines: Integer;
  1053.   DestScanLine: Pointer;
  1054.   PtrInc: Integer;
  1055.   jc: TJPEGContext;
  1056. begin
  1057.   Result := FBitmap;
  1058.   if Result <> nil then Exit;
  1059.   if (FBitmap = nil) then FBitmap := TBitmap.Create;
  1060.   Result := FBitmap;
  1061.  
  1062.   InitDecompressor(Self, jc);
  1063.   try
  1064.     try
  1065.       // Set the bitmap pixel format
  1066.       FBitmap.Handle := 0;
  1067.       if (PixelFormat = jf8Bit) or (jc.d.out_color_space = JCS_GRAYSCALE) then
  1068.         FBitmap.PixelFormat := pf8bit
  1069.       else
  1070.         FBitmap.PixelFormat := pf24bit;
  1071.  
  1072.       Progress(Self, psStarting, 0, False, Rect(0,0,0,0), '');
  1073.       try
  1074.         jpeg_start_decompress(jc.d);
  1075.  
  1076.         // extract color palette
  1077.         if (jc.d.colormap <> nil) and (FBitmap.PixelFormat = pf8bit) then
  1078.           FBitmap.Palette := BuildPalette(jc.d);
  1079.  
  1080.         if FTempPal <> 0 then
  1081.         begin
  1082.           PaletteModified := True;
  1083. //          Changed(Self);
  1084.           DeleteObject(FTempPal);
  1085.           FTempPal := 0;
  1086.         end;
  1087.  
  1088.         // Set bitmap width and height
  1089.         with FBitmap do
  1090.         begin
  1091.           Width := jc.d.output_width;
  1092.           Height := jc.d.output_height;
  1093.           DestScanline := ScanLine[0];
  1094.           PtrInc := Integer(ScanLine[1]) - Integer(DestScanline);
  1095.         end;
  1096.  
  1097.         if jc.d.buffered_image then
  1098.         begin  // decode progressive scans at low quality, high speed
  1099.           while jpeg_consume_input(jc.d) <> JPEG_REACHED_EOI do
  1100.           begin
  1101.             DestScanLine := FBitmap.ScanLine[0];
  1102.             jpeg_start_output(jc.d, jc.d.input_scan_number);
  1103.             while (jc.d.output_scanline < jc.d.output_height) do
  1104.             begin
  1105.               num_scanlines := jpeg_read_scanlines(jc.d, @DestScanline, jc.d.rec_outbuf_height);
  1106.               Inc(Integer(DestScanline), PtrInc * num_scanlines);
  1107.             end;
  1108.             jpeg_finish_output(jc.d);
  1109.           end;
  1110.           // reset options for final pass at requested quality
  1111.           jc.d.dct_method := jc.FinalDCT;
  1112.           jc.d.dither_mode := jc.FinalDitherMode;
  1113.           if jc.FinalTwoPassQuant then
  1114.           begin
  1115.             jc.d.two_pass_quantize := True;
  1116.             jc.d.colormap := nil;
  1117.           end;
  1118.           jpeg_start_output(jc.d, jc.d.input_scan_number);
  1119.           DestScanLine := FBitmap.ScanLine[0];
  1120.           // build final color palette
  1121.           if jc.FinalTwoPassQuant and (jc.d.colormap <> nil) then
  1122.             FBitmap.Palette := BuildPalette(jc.d);
  1123.         end;
  1124.  
  1125.         // final image pass for progressive, first and only pass for baseline
  1126.         while (jc.d.output_scanline < jc.d.output_height) do
  1127.         begin
  1128.           num_scanlines := jpeg_read_scanlines(jc.d, @DestScanline, jc.d.rec_outbuf_height);
  1129.           Inc(Integer(DestScanline), PtrInc * num_scanlines);
  1130.         end;
  1131.  
  1132.         if jc.d.buffered_image then jpeg_finish_output(jc.d);
  1133.         jpeg_finish_decompress(jc.d);
  1134.       finally
  1135.         if ExceptObject = nil then
  1136.           PtrInc := 100
  1137.         else
  1138.           PtrInc := 0;
  1139.         Progress(Self, psEnding, PtrInc, False, Rect(0,0,0,0), '');
  1140.       end;
  1141.     except
  1142.       on EAbort do ;   // OnProgress can raise EAbort to cancel image load
  1143.     end;
  1144.   finally
  1145.     ReleaseContext(jc);
  1146.   end;
  1147. end;
  1148.  
  1149. {
  1150. function TJPEGImage.GetComments: TStrings;
  1151. begin
  1152.   if not FImage.FAttributesLoaded and (FImage.FData <> nil) then
  1153.     LoadAttributes;
  1154.   Inc(FChanging);
  1155.   try
  1156.     FComments.Assign(FImage.FComments);
  1157.   finally
  1158.     Dec(FChanging);
  1159.   end;
  1160.   Result := FComments;
  1161. end;
  1162. }
  1163.  
  1164. function TJPEGImage.GetEmpty: Boolean;
  1165. begin
  1166.   Result := (FImage.FData = nil) and FBitmap.Empty;
  1167. end;
  1168.  
  1169. function TJPEGImage.GetGrayscale: Boolean;
  1170. begin
  1171.   Result := FGrayscale or FImage.FGrayscale;
  1172. end;
  1173.  
  1174. function TJPEGImage.GetPalette: HPalette;
  1175. var
  1176.   jc: TJPEGContext;
  1177.   DC: HDC;
  1178. begin
  1179.   Result := 0;
  1180.   if FBitmap <> nil then
  1181.     Result := FBitmap.Palette
  1182.   else if FTempPal <> 0 then
  1183.     Result := FTempPal
  1184.   else if (PixelFormat = jf8bit) or Grayscale then
  1185.   begin
  1186.     InitDecompressor(Self, jc);
  1187.     try
  1188.       jc.common.progress := nil;
  1189.       if jc.d.out_color_space <> JCS_GRAYSCALE then
  1190.         jpeg_start_decompress(jc.d);
  1191.       FTempPal := BuildPalette(jc.d);
  1192.       Result := FTempPal;
  1193.     finally
  1194.       ReleaseContext(jc);
  1195.     end;
  1196.   end
  1197.   else
  1198.   begin // 24bit image.  Check for 8 bit screen
  1199.     DC := GetDC(0);
  1200.     if (GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES)) <= 8 then
  1201.     begin
  1202.       FTempPal := CreateHalftonePalette(DC);
  1203.       Result := FTempPal;
  1204.     end;
  1205.     ReleaseDC(0, DC);
  1206.   end;
  1207. end;
  1208.  
  1209. function TJPEGImage.GetHeight: Integer;
  1210. begin
  1211.   if FBitmap <> nil then
  1212.     Result := FBitmap.Height
  1213.   else if FScale = jsFullSize then
  1214.     Result := FImage.FHeight
  1215.   else
  1216.   begin
  1217.     CalcOutputDimensions;
  1218.     Result := FScaledHeight;
  1219.   end;
  1220. end;
  1221.  
  1222. function TJPEGImage.GetWidth: Integer;
  1223. begin
  1224.   if FBitmap <> nil then
  1225.     Result := FBitmap.Width
  1226.   else if FScale = jsFullSize then
  1227.     Result := FImage.FWidth
  1228.   else
  1229.   begin
  1230.     CalcOutputDimensions;
  1231.     Result := FScaledWidth;
  1232.   end;
  1233. end;
  1234.  
  1235. procedure TJPEGImage.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  1236.   APalette: HPALETTE);
  1237. begin
  1238.   //!! check for jpeg clipboard data, mime type image/jpeg
  1239.   FBitmap.LoadFromClipboardFormat(AFormat, AData, APalette);
  1240. end;
  1241.  
  1242. procedure TJPEGImage.LoadFromStream(Stream: TStream);
  1243. begin
  1244.   ReadStream(Stream.Size - Stream.Position, Stream);
  1245. end;
  1246.  
  1247. procedure TJPEGImage.NewBitmap;
  1248. begin
  1249.   FBitmap.Free;
  1250.   FBitmap := TBitmap.Create;
  1251. end;
  1252.  
  1253. procedure TJPEGImage.NewImage;
  1254. begin
  1255.   if FImage <> nil then FImage.Release;
  1256.   FImage := TJPEGData.Create;
  1257.   FImage.Reference;
  1258. end;
  1259.  
  1260. procedure TJPEGImage.ReadData(Stream: TStream);
  1261. var
  1262.   Size: Longint;
  1263. begin
  1264.   Stream.Read(Size, SizeOf(Size));
  1265.   ReadStream(Size, Stream);
  1266. end;
  1267.  
  1268. procedure TJPEGImage.ReadStream(Size: Longint; Stream: TStream);
  1269. var
  1270.   jerr: jpeg_error_mgr;
  1271.   cinfo: jpeg_decompress_struct;
  1272. begin
  1273.   NewImage;
  1274.   with FImage do
  1275.   begin
  1276.     FData := TMemoryStream.Create;
  1277.     TMemoryStream(FData).SetSize(Size);
  1278.     Stream.ReadBuffer(FData.Memory^, Size);
  1279.     if Size > 0 then
  1280.     begin
  1281.       jerr := jpeg_std_error;  // use local var for thread isolation
  1282.       cinfo.common.err := @jerr;
  1283.       jpeg_CreateDecompress(cinfo, JPEG_LIB_VERSION, sizeof(cinfo));
  1284.       try
  1285.         FData.Position := 0;
  1286.         jpeg_stdio_src(cinfo, FData);
  1287.         jpeg_read_header(cinfo, TRUE);
  1288.         FWidth := cinfo.image_width;
  1289.         FHeight := cinfo.image_height;
  1290.         FAspectUnit := TJPEGAspectUnit(cinfo.density_unit);
  1291.         FAspectRatio.X := cinfo.X_density;
  1292.         FAspectRatio.Y := cinfo.Y_density;
  1293.         FGrayscale := cinfo.jpeg_color_space = JCS_GRAYSCALE;
  1294.         FProgressiveEncoding := jpeg_has_multiple_scans(cinfo);
  1295.       finally
  1296.         jpeg_destroy_decompress(cinfo);
  1297.       end;
  1298.     end;
  1299.   end;
  1300.   PaletteModified := True;
  1301.   Changed(Self);
  1302. end;
  1303.  
  1304. procedure TJPEGImage.SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  1305.   var APalette: HPALETTE);
  1306. begin
  1307. //!!  check for jpeg clipboard format, mime type image/jpeg
  1308.   Bitmap.SaveToClipboardFormat(AFormat, AData, APalette);
  1309. end;
  1310.  
  1311. procedure TJPEGImage.SaveToStream(Stream: TStream);
  1312. begin
  1313.   if FImage.FData = nil then  //!! compress bitmap
  1314.     raise EInvalidGraphicOperation.Create('No JPEG data to write');
  1315.   with FImage.FData do
  1316.     Stream.Write(Memory^, Size);
  1317. end;
  1318.  
  1319. procedure TJPEGImage.SetGrayscale(Value: Boolean);
  1320. begin
  1321.   if FGrayscale <> Value then
  1322.   begin
  1323.     FreeBitmap;
  1324.     FGrayscale := Value;
  1325.     PaletteModified := True;
  1326.     Changed(Self);
  1327.   end;
  1328. end;
  1329.  
  1330. procedure TJPEGImage.SetHeight(Value: Integer);
  1331. begin
  1332.   InvalidOperation(SChangeJPGSize);
  1333. end;
  1334.  
  1335. procedure TJPEGImage.SetPerformance(Value: TJPEGPerformance);
  1336. begin
  1337.   if FPerformance <> Value then
  1338.   begin
  1339.     FreeBitmap;
  1340.     FPerformance := Value;
  1341.     PaletteModified := True;
  1342.     Changed(Self);
  1343.   end;
  1344. end;
  1345.  
  1346. procedure TJPEGImage.SetPixelFormat(Value: TJPEGPixelFormat);
  1347. begin
  1348.   if FPixelFormat <> Value then
  1349.   begin
  1350.     FreeBitmap;
  1351.     FPixelFormat := Value;
  1352.     PaletteModified := True;
  1353.     Changed(Self);
  1354.   end;
  1355. end;
  1356.  
  1357. procedure TJPEGImage.SetScale(Value: TJPEGScale);
  1358. begin
  1359.   if FScale <> Value then
  1360.   begin
  1361.     FreeBitmap;
  1362.     FScale := Value;
  1363.     FNeedRecalc := True;
  1364.     Changed(Self);
  1365.   end;
  1366. end;
  1367.  
  1368. procedure TJPEGImage.SetSmoothing(Value: Boolean);
  1369. begin
  1370.   if FSmoothing <> Value then
  1371.   begin
  1372.     FreeBitmap;
  1373.     FSmoothing := Value;
  1374.     Changed(Self);
  1375.   end;
  1376. end;
  1377.  
  1378. procedure TJPEGImage.SetWidth(Value: Integer);
  1379. begin
  1380.   InvalidOperation(SChangeJPGSize);
  1381. end;
  1382.  
  1383. procedure TJPEGImage.WriteData(Stream: TStream);
  1384. var
  1385.   Size: Longint;
  1386. begin
  1387.   Size := 0;
  1388.   if Assigned(FImage.FData) then Size := FImage.FData.Size;
  1389.   Stream.Write(Size, Sizeof(Size));
  1390.   if Size > 0 then Stream.Write(FImage.FData.Memory^, Size);
  1391. end;
  1392.  
  1393. initialization
  1394.   TPicture.RegisterFileFormat('jpg', 'JPEG Image File', TJPEGImage);
  1395.   TPicture.RegisterFileFormat('jpeg', 'JPEG Image File', TJPEGImage);
  1396. finalization
  1397.   TPicture.UnRegisterGraphicClass(TJPEGImage);
  1398. end.
  1399.  
  1400.  
  1401.